home *** CD-ROM | disk | FTP | other *** search
/ TPUG - Toronto PET Users Group / TPUG Users Group CD / TPUG Users Group CD.iso / AMIGA / (A)Z / (A)Z11.ADF / LOGO / LOGOSOURCE / logonum.c < prev    next >
C/C++ Source or Header  |  2009-11-14  |  5KB  |  248 lines
  1.  
  2. /*    Numeric operations in LOGO.
  3.  *    In arithmetic operations, the input, which is a character, is
  4.  *    converted to numeric, the operations are done, and the result is
  5.  *    converted back to character.
  6.  *    In all cases, the inputs are freed, and a new output is created.
  7.  *
  8.  *    Copyright (C) 1979, The Children's Museum, Boston, Mass.
  9.  *    Written by Douglas B. Klunder.
  10.  */
  11.  
  12. #include <math.h>
  13. #include "logo.h"
  14.  
  15. nump(x)        /* non-LOGO numberp, just for strings */
  16. register struct object *x;
  17. {    /* a number is a series of at least one digit, with an optional
  18.     * starting + or -. */
  19.     register char ch,*cp;
  20.  
  21.     cp = x->obstr;
  22.     if (*cp=='\0') return(0);
  23.     if (*cp!='-' && *cp!='+' && (*cp<'0' || *cp>'9') && *cp!='.') return(0);
  24.     if ((*cp=='-' || *cp=='+' || *cp=='.') && *(cp+1)=='\0') return(0);
  25.     if(*cp=='.' && index(cp+1,'.')) return(0);
  26.     cp++;
  27.     while ((ch = *cp)!='\0') {
  28.         if ((ch<'0'||ch>'9')&&(ch!='e')&&(ch!='E')&&(ch!='.'))
  29.             return(0);
  30.         if ((ch == 'e') || (ch == 'E')) {
  31.             if (index(cp+1,'e') || index(cp+1,'E')
  32.               || index(cp+1,'.')) return(0);
  33.             if (((ch = *(cp+1))=='+') || (ch=='-')) cp++;
  34.         }
  35.         else if (ch == '.') {
  36.             if (index(cp+1,'e') || index(cp+1,'E')
  37.               || index(cp+1,'.')) return(0);
  38.         }
  39.         cp++;
  40.     }
  41.     return(1);
  42. }
  43.  
  44. /* Check a STRING object to see if it's an integer string */
  45. isint(x)
  46. register struct object *x;
  47. {
  48.     register char ch,*cp;
  49.  
  50.     cp = x->obstr;
  51.     while (ch = *cp++)
  52.         if ((ch == '.') || (ch == 'e') || (ch == 'E'))
  53.             return(0);
  54.     return(1);
  55. }
  56.  
  57. /* convert object (which might be a word of digits) to a number */
  58. struct object *numconv(thing,op)
  59. register struct object *thing;
  60. char *op;
  61. {
  62.     register struct object *newthing;
  63.     FIXNUM ithing;
  64.     NUMBER dthing;
  65.  
  66.     if (thing == 0) ungood(op,thing);
  67.     switch (thing->obtype) {
  68.         case CONS:
  69.             ungood(op,thing);
  70.         case INT:
  71.         case DUB:
  72.             return(thing);
  73.         default:
  74.             if (!nump(thing)) ungood(op,thing);
  75.             if (isint(thing)) {
  76.                 sscanf(thing->obstr,FIXFMT,&ithing);
  77.                 newthing = localize(objint(ithing));
  78.             } else {
  79.                 sscanf(thing->obstr,EFMT,&dthing);
  80.                 newthing = localize(objdub(dthing));
  81.             }
  82.     }
  83.     mfree(thing);
  84.     return(newthing);
  85. }
  86.  
  87. /* convert integer to double */
  88. struct object *dubconv(num)
  89. register struct object *num;
  90. {
  91.     NUMBER d;
  92.  
  93.     if (dubp(num)) return(num);
  94.     d = num->obint;
  95.     mfree(num);
  96.     return(localize(objdub(d)));
  97. }
  98.  
  99. struct object *opp(x)    /* Unary - */
  100. register struct object *x;
  101. {
  102.     register struct object *ans;
  103.  
  104.     x = numconv(x,"Minus");
  105.     if (intp(x)) {
  106.         ans = objint(-(x->obint));
  107.     } else {
  108.         ans = objdub(-(x->obdub));
  109.     }
  110.     mfree(x);
  111.     return(localize(ans));
  112. }
  113.  
  114. struct object *add(x,y)    /* sum */
  115. register struct object *x,*y;
  116. {
  117.     FIXNUM iz;
  118.     NUMBER dz;
  119.     register struct object *z;
  120.  
  121.     x = numconv(x,"Sum");
  122.     y = numconv(y,"Sum");
  123.     if (!intp(x) || !intp(y)) {
  124.         x = dubconv(x);
  125.         y = dubconv(y);
  126.     }
  127.     if (intp(x)) {
  128.         iz = (x->obint)+(y->obint);
  129.         z = objint(iz);
  130.     } else {
  131.         dz = (x->obdub)+(y->obdub);
  132.         z = objdub(dz);
  133.     }
  134.     mfree(x);
  135.     mfree(y);
  136.     return(localize(z));
  137. }
  138.  
  139. struct object *sub(x,y)    /* difference */
  140. register struct object *x,*y;
  141. {
  142.     FIXNUM iz;
  143.     NUMBER dz;
  144.     register struct object *z;
  145.  
  146.     x = numconv(x,"Difference");
  147.     y = numconv(y,"Difference");
  148.     if (!intp(x) || !intp(y)) {
  149.         x = dubconv(x);
  150.         y = dubconv(y);
  151.     }
  152.     if (intp(x)) {
  153.         iz = (x->obint)-(y->obint);
  154.         z = objint(iz);
  155.     } else {
  156.         dz = (x->obdub)-(y->obdub);
  157.         z = objdub(dz);
  158.     }
  159.     mfree(x);
  160.     mfree(y);
  161.     return(localize(z));
  162. }
  163.  
  164. struct object *mult(x,y)    /* product */
  165. register struct object *x,*y;
  166. {
  167.     FIXNUM iz;
  168.     NUMBER dz;
  169.     register struct object *z;
  170.  
  171.     x = numconv(x,"Product");
  172.     y = numconv(y,"Product");
  173.     if (!intp(x) || !intp(y)) {
  174.         x = dubconv(x);
  175.         y = dubconv(y);
  176.     }
  177.     if (intp(x)) {
  178.         iz = (x->obint)*(y->obint);
  179.         z = objint(iz);
  180.     } else {
  181.         dz = (x->obdub)*(y->obdub);
  182.         z = objdub(dz);
  183.     }
  184.     mfree(x);
  185.     mfree(y);
  186.     return(localize(z));
  187. }
  188.  
  189. divzero(name)
  190. char *name;
  191. {
  192.     pf1("%s can't divide by zero.\n",name);
  193.     errhand();
  194. }
  195.  
  196. struct object *div(x,y)    /* quotient */
  197. register struct object *x,*y;
  198. {
  199.     NUMBER dz;
  200.  
  201.     x = numconv(x,"Quotient");
  202.     y = numconv(y,"Quotient");
  203.     x = dubconv(x);
  204.     y = dubconv(y);
  205.     if (y->obdub == 0.0) divzero("Quotient");
  206.     dz = (x->obdub)/(y->obdub);
  207.     mfree(x);
  208.     mfree(y);
  209.     if (dz == (NUMBER)(FIXNUM)dz) {
  210.         return(localize(objint((FIXNUM)dz)));
  211.     } else {
  212.         return(localize(objdub(dz)));
  213.     }
  214. }
  215.  
  216. struct object *rem(x,y)    /* remainder */
  217. register struct object *x,*y;
  218. {
  219.     FIXNUM iz;
  220.     register struct object *z;
  221.  
  222.     x = numconv(x,"Remainder");
  223.     y = numconv(y,"Remainder");
  224.     if (!intp(x)) ungood("Remainder",x);
  225.     if (!intp(y)) ungood("Remainder",y);
  226.     if (y->obint == 0) divzero("Remainder");
  227.     iz = (x->obint)%(y->obint);
  228.     z = objint(iz);
  229.     mfree(x);
  230.     mfree(y);
  231.     return(localize(z));
  232. }
  233.  
  234. struct object *torf(pred)
  235. int pred;
  236. {
  237.     if (pred) return(true());
  238.     return(false());
  239. }
  240.  
  241. struct object *greatp(x,y)    /* greaterp */
  242. register struct object *x,*y;
  243. {
  244.     int iz;
  245.  
  246.     x = numconv(x,"Greaterp");
  247.     y = numconv(y,"Greaterp");
  248.     if